Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbpxen/checkout.frm

Visual Basic Form | 1995-10-23 | 8.0 KB | 280 lines

VERSION 2.00
Begin Form Checkout
   Caption         =   "Check Out"
   ClientHeight    =   4875
   ClientLeft      =   1050
   ClientTop       =   1485
   ClientWidth     =   5280
   Height          =   5280
   Left            =   990
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4875
   ScaleWidth      =   5280
   Top             =   1140
   Width           =   5400
   Begin TextBox tapenumber
      Height          =   375
      Index           =   4
      Left            =   120
      TabIndex        =   5
      Text            =   " "
      Top             =   4320
      Width           =   1095
   End
   Begin TextBox tapenumber
      Height          =   375
      Index           =   3
      Left            =   120
      TabIndex        =   4
      Text            =   " "
      Top             =   3840
      Width           =   1095
   End
   Begin TextBox tapenumber
      Height          =   375
      Index           =   2
      Left            =   120
      TabIndex        =   3
      Text            =   " "
      Top             =   3360
      Width           =   1095
   End
   Begin TextBox tapenumber
      Height          =   375
      Index           =   1
      Left            =   120
      TabIndex        =   2
      Text            =   " "
      Top             =   2880
      Width           =   1095
   End
   Begin TextBox tapenumber
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Text            =   " "
      Top             =   2400
      Width           =   1095
   End
   Begin TextBox custnumber
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Text            =   " "
      Top             =   1440
      Width           =   1095
   End
   Begin CommandButton ButtonCancel
      Caption         =   "&Cancel"
      Height          =   615
      Left            =   1920
      TabIndex        =   7
      Top             =   120
      Width           =   1095
   End
   Begin CommandButton ButtonOK
      Caption         =   "&OK"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   240
      TabIndex        =   6
      Top             =   120
      Width           =   1095
   End
   Begin Label tapetitle
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      Height          =   375
      Index           =   4
      Left            =   1560
      TabIndex        =   15
      Top             =   4320
      Width           =   3615
   End
   Begin Label tapetitle
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      Height          =   375
      Index           =   3
      Left            =   1560
      TabIndex        =   14
      Top             =   3840
      Width           =   3615
   End
   Begin Label tapetitle
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      Height          =   375
      Index           =   2
      Left            =   1560
      TabIndex        =   13
      Top             =   3360
      Width           =   3615
   End
   Begin Label tapetitle
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      Height          =   375
      Index           =   1
      Left            =   1560
      TabIndex        =   12
      Top             =   2880
      Width           =   3615
   End
   Begin Label tapetitle
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   0
      Left            =   1560
      TabIndex        =   11
      Top             =   2400
      Width           =   3615
   End
   Begin Label Label2
      Caption         =   "Tape number:"
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   1920
      Width           =   1335
   End
   Begin Label custname
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      Height          =   375
      Left            =   1560
      TabIndex        =   10
      Top             =   1440
      Width           =   2535
   End
   Begin Label Label1
      Caption         =   "Customer number:"
      Height          =   375
      Left            =   120
      TabIndex        =   8
      Top             =   960
      Width           =   1695
   End
Sub ButtonCancel_Click ()
    custnumber.text = " "
    For i% = 0 To 4
        tapenumber(i%).text = " "
        tapetitle(i%).caption = " "
    Next i%
    custnumber.SetFocus
    checkout.Hide
End Sub
Sub ButtonExit_Click ()
    checkout.Hide
End Sub
Sub ButtonOK_Click ()
    Dim iNumTapes As Integer
    '
    '  Make the customer rec is there
    '  But do not update it yet
    '
    screen.MousePointer = POINTER_HOURGLASS
    custrec.custnumber = custnumber.text
    ' rc = GetCustomerRec(DBKEYED)
    rc = 0
    If rc Then
        custnumber.SetFocus
        custname.caption = " "
        screen.MousePointer = POINTER_DEFAULT
        Exit Sub
    End If
    '
    '  Get each tape and update
    '
    iNumTapes = 0
    For i% = 0 To 4
        If tapenumber(i%).text <> " " Then
            itemrec.itemnumber = tapenumber(i%).text
            rc = GetItemRec(DBKEYED)
            If rc Then
                msg$ = "Tape " + tapenumber(i%).text + " deleted! "
                MsgBox msg$, MB_ICONEXLAMATION
            Else
                inout$ = Left$(itemrec.inout_code, 1)
                If inout$ = "O" Then
                    msg$ = "Tape is already out, number: " + itemrec.itemnumber
                    MsgBox msg$, MB_ICONEXCLAMATION
                    tapetitle(i%).caption = "Already out"
                Else
                    itemrec.custnum = custrec.custnumber
                    itemrec.inout_code = "OUT"
                    rc = UpdateItemRec()
                    tapetitle(i%).caption = "OK"
                    iNumTapes = iNumTapes + 1
                End If
            End If
        End If
    Next i%
    '
    '  Get the customer again and update as quickly
    '  as possible.  Should lock it, but requires more code
    '
    rc = GetCustomerRec(DBKEYED)
    custrec.tapes_out = custrec.tapes_out + iNumTapes
    rc = UpdateCustomerRec()
    '
    '  Clear the screen for the next checkout
    '
    custnumber.text = " "
    For i% = 0 To 4
        tapenumber(i%).text = " "
        '  ***  tapetitle(i%).caption = " "
    Next i%
    custnumber.SetFocus
    screen.MousePointer = POINTER_DEFAULT
    Exit Sub
End Sub
Sub custnumber_LostFocus ()
    If custnumber.text = " " Then
        Exit Sub
    End If
    custrec.custnumber = custnumber.text
    rc = GetCustomerRec(DBKEYED)
    If rc Then
        custnumber.SetFocus
        custname.caption = " "
        Exit Sub
    End If
    '
    '  need to trim trailing blanks from the last name
    '
    TheFullName$ = custrec.lastname + ", " + custrec.firstname
    custname.caption = TheFullName$
End Sub
Sub Form_Load ()
    custnumber.text = " "
    custname.caption = " "
    For i% = 0 To 4
        tapenumber(i%).text = " "
        tapetitle(i%).caption = " "
    Next i%
    ' ??  whats wrong with this -  custnumber.SetFocus
End Sub
Sub tapenumber_LostFocus (i As Integer)
    If tapenumber(i).text = " " Then
        Exit Sub
    End If
    itemrec.itemnumber = tapenumber(i).text
    rc = GetItemRec(DBKEYED)
    If rc Then
        tapenumber(i).SetFocus
        tapetitle(i).caption = " "
        Exit Sub
    End If
    tapetitle(i).caption = itemrec.itemdesc
End Sub